open Unix
open Histo

(** Histogram plotting by CERN ROOT program *)

module H1ROOT=struct
    include H1
let draw_hist_f ch h=
    let l=Array.length h.arr in
    Printf.fprintf ch "{\nTH1D *h;\nif(h) delete h;\n";
    Printf.fprintf ch "h=new TH1D(\"%s\",\"%s\",%i,%f,%f);\n"
        h.info.name h.info.title l h.x_min h.x_max;
    for k=0 to l-1 do
        Printf.fprintf ch "h->SetBinContent(%i,%f);\n" k h.arr.(k)
    done;
    Printf.fprintf ch "h->SetEntries(%i);\n" h.entries;
    Printf.fprintf ch "h->Draw();\n";
    Printf.fprintf ch "}\n}\n"; (* ROOT sometimes fails to work without 
    second brace :-O !!! *)
    Pervasives.flush ch;
    Printf.eprintf "hist: u=%f o=%f e=%i\n" h.underflow h.overflow h.entries;
end
(*
module H1 : H1_draw = struct
    include Histo.H1
    let draw_hist h=draw_hist1d_f ch h
end
*)
module H2ROOT=struct
    include H2
let draw_hist_f ch h=
    Printf.fprintf ch "{\nTH2D *h2;\nif(h2) delete h2;\n";
    Printf.fprintf ch "h2=new TH2D(\"%s\",\"%s\",%i,%f,%f,%i,%f,%f);\n"
        h.info.name h.info.title
        h.n_x h.x_min h.x_max
        h.n_y h.y_min h.y_max;
    for ix=0 to h.n_x-1 do
        for iy=0 to h.n_y-1 do
            Printf.fprintf ch "h2->SetBinContent(%i,%i,%f);\n" ix iy
            h.arr.(ix).(iy)
        done
    done;
    Printf.fprintf ch "h2->Draw();\n}\n";
    Printf.fprintf ch "}\n"; (* ROOT sometimes fails to work without 
    this brace :-O !!! *)
    Pervasives.flush ch;
    Printf.eprintf "hist: e=%i\n" h.entries;
end
(*
module H2 : H2_draw = struct
    include Histo.H2
    let draw_hist h=draw_hist2d_f ch h
end
*)
let make_pipe ()=
    let (input,output)=Unix.pipe () in
    let pid=Unix.fork () in
    if pid=0 then begin
        Unix.close output;
        Unix.dup2 input Unix.stdin;
        Unix.execvp "root" [|"root";"-l"|]; (*never return*)
        (0,out_channel_of_descr Unix.stdin)
    end
    else begin 
        Unix.close input; 
        let ch=out_channel_of_descr output in
        (pid,ch)
    end

let wait pid=
    Unix.waitpid [] pid

let close descr=
    Printf.fprintf descr "\n.q\n"
(*    Unix.close (Unix.descr_of_out_channel descr)*)

let draw_hist_to descr=
(*    let (pid,descr)=make_pipe () in*)
    fun histo -> 
        match histo with 
        H1d h -> H1ROOT.draw_hist_f descr h
      | H2d h -> H2ROOT.draw_hist_f descr h

let test_hist () =
    let hi=init_hist (H1.h ~xa:{n=100;x1= -5.; x2=5.}
    {name="h";title="gaus"}) (Glob.gaus
    1.0 0.5 0.5) in
    let (pid,ch)=make_pipe () in
    H1ROOT.draw_hist_f ch hi;
    wait pid
